Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/DBL Pascal Library/INIT Shell Folder/INIT Shell ƒ/Shell ƒ/INITShellLoader.p

Text File | 1990-06-24 | 11.8 KB | 409 lines | [TEXT/PJMM]

unit INITShellLoader;
{Copyright © 1990, David B. Lamkins}
{All rights reserved.}

interface

    uses
        Retrace, SysEqu, INITDoInstall;

    procedure main;    {INIT entry point}

implementation

{•• There is no code here which needs to be modified.}
{•• All of your INIT programming should take place in the INITDoInstall unit.}

{This is the main code of the INIT loader.  Variables of main are pseudo-globals for all of}
{its subroutines.}
    procedure main;
        const
            trapNumMask = $1FF;        {low 9 bits of trap opcode contain trap number}
            ResidentType = 'IRES';    {the resource type of patches and VBLs loaded by this INIT}
            loadOK = 128;            {ICN# for "normal successful installation"}
            loadSkipped = 129;        {ICN# for "the INIT was skipped because the mouse button was down"}
            loadFailed = 130;            {ICN# for "something has gone wrong"}
            loadNotDone = 131;        {ICN# for "not loaded due to configuration"}

        type
            PatchInfo = record
                    trapOpCode: INTEGER;
                    oldAddress: LONGINT;
                    patchHandle: Handle;
                end;
            PatchInfoArray = array[1..1] of PatchInfo;
            PatchInfoArrayPtr = ^PatchInfoArray;
            VBLInfo = record
                    queuePtr: QElemPtr;
                    taskHandle: Handle;
                end;
            VBLInfoArray = array[1..1] of VBLInfo;
            VBLInfoArrayPtr = ^VBLInfoArray;
            QDGlobals = record
                    private: packed array[1..202] of Byte;
                    thePort: GrafPtr;
                end;
            LongPtr = ^LONGINT;
            InstallState = (OK, Failed, Cancelled);

        var
            PatchesInfoPtr: PatchInfoArrayPtr;
            VBLsInfoPtr: VBLInfoArrayPtr;
            NumPatches, NumVBLs: INTEGER;
            MaxPatches, MaxVBLs: INTEGER;
            theState: InstallState;
            EnableIcon: BOOLEAN;
            theINITGlobals: Handle;
            saveA5: LONGINT;
            myPort: GrafPort;
            localQD: QDGlobals;
            localA5: LONGINT;

{This procedure is called at patch/VBL installation time to stash the globals handle into the}
{modified code header for the patch/VBL code.  The handle is created by StartInstall.  Additionally,}
{the code header is modified to allow a jump to a patched trap by using SetTrapExit prior to}
{returning from the patch code.}
        procedure SetGlobalPtr (codeAddress: Ptr; trapAddress: LONGINT);
            type
                CodeHeader = record
                        BSR_instruction: INTEGER;                    {BSR.S *+$10}
                        RTS_instruction: INTEGER;                    {RTS}
                        JMP_opcode: INTEGER;                        {JMP patched_routine}
                        JMP_address: LONGINT;
                        LockCount: INTEGER;                            {number of times globals have been locked}
                        GlobalH: Handle;                                {handle to our globals}
                    end;
                CodeHeaderPtr = ^CodeHeader;

        begin
            with CodeHeaderPtr(codeAddress)^ do
                begin
                    BSR_instruction := $610E;
                    RTS_instruction := $4E75;
                    JMP_opcode := $4EF9;
                    JMP_address := trapAddress;
                    LockCount := 0;
                    GlobalH := theINITGlobals;
                end;
        end;

{Here is how we remember the things we'll need to undo a trap patch…}
        procedure RememberPatch (h: Handle; trap: INTEGER; originalAddress: LONGINT);
        begin
            numPatches := numPatches + 1;
            if numPatches <= MaxPatches then
{$PUSH}
{$R-}
                with PatchesInfoPtr^[numPatches] do
                    begin
                        patchHandle := h;
                        trapOpCode := trap;
                        oldAddress := originalAddress;
                    end;
{$POP}
        end;

{This corresponds to the previous routine, but for VBL tasks…}
        procedure RememberVBL (h: Handle; q: QElemPtr);
        begin
            NumVBLs := NumVBLs + 1;
            if NumVBLs <= MaxVBLs then
{$PUSH}
{$R-}
                with VBLsInfoPtr^[NumVBLs] do
                    begin
                        taskHandle := h;
                        queuePtr := q;
                    end;
{$POP}
        end;

{This is a pre-initialization to make sure the loader stays sane even if we forget to call}
{DoInstall(initCallback,…).}
        procedure StartInstall;
        begin
            theState := Failed;
            NumPatches := 0;
            MaxPatches := 0;
            PatchesInfoPtr := PatchInfoArrayPtr(NewPtr(0));
            NumVBLs := 0;
            MaxVBLs := 0;
            VBLsInfoPtr := VBLInfoArrayPtr(NewPtr(0));
            theINITGlobals := NewHandleSysClear(0);
        end;

{Here is where we initalize the state of the INIT Shell Loader.  Also, we clear the DeskHook}
{and the DragHook per Apple's Tech Note 247.}
        procedure InitInstaller (patchLimit, VBLLimit, sizeOfGlobals: INTEGER);
        begin
            theState := OK;
            EnableIcon := TRUE;
            MaxPatches := patchLimit;
            DisposPtr(Ptr(PatchesInfoPtr));
            PatchesInfoPtr := PatchInfoArrayPtr(NewPtr(SIZEOF(PatchInfo) * MaxPatches));
            MaxVBLs := VBLLimit;
            DisposPtr(Ptr(VBLsInfoPtr));
            VBLsInfoPtr := VBLInfoArrayPtr(NewPtr(SIZEOF(VBLInfo) * MaxVBLs));
            SetHandleSize(theINITGlobals, sizeOfGlobals);
            LongPtr(DeskHook)^ := 0;    {according to TN 247}
            LongPtr(DragHook)^ := 0;    {ditto}
        end;

{Before we finish installation, we call this to dispose the pointers used internally.}
        procedure EndInstall;
        begin
            DisposPtr(Ptr(PatchesInfoPtr));
            DisposPtr(Ptr(VBLsInfoPtr));
        end;

{If something goes wrong during the installation, we call AbortInstall to unhook all the trap}
{patches and VBL tasks that had been installed by the loader.}
        procedure AbortInstall;
            var
                i: INTEGER;
                error: OSErr;
                theTrapKind: TrapType;
        begin
            for i := 1 to NumVBLs do
{$PUSH}
{$R-}
                with VBLsInfoPtr^[i] do
                    begin
                        error := VRemove(queuePtr);
                        DisposHandle(taskHandle);
                    end;
{$POP}
            for i := 1 to NumPatches do
{$PUSH}
{$R-}
                with PatchesInfoPtr^[i] do
                    begin
                        if BTST(trapOpCode, 11) then
                            theTrapKind := ToolTrap
                        else
                            theTrapKind := OSTrap;
                        NSetTrapAddress(oldAddress, BAND(trapNumMask, trapOpCode), theTrapKind);
                        DisposHandle(patchHandle);
                    end;
{$POP}
            DisposHandle(theINITGlobals);
        end;

{Here is where we actually install a trap patch.  The patch code is referenced by resource ID}
{(for a resource of type ResidentType, which is normally IRES).  The trap is referenced by}
{its full opcode, not just the number (i.e. _Open = $A000).  Note that if something goes wrong,}
{this fact is reflected in the loader global theState, and future patch installs are automatically}
{skipped.}
        procedure InstallPatch (id, trap: INTEGER);
            var
                thePatch: Handle;
                theGlobalsHandle: Handle;
                theTrapAddress: LONGINT;
                theTrapKind: TrapType;

        begin
            if theState = OK then
                begin
                    thePatch := GetResource(ResidentType, id);
                    if thePatch <> nil then
                        begin
                            HLock(thePatch);
                            if BTST(trap, 11) then
                                theTrapKind := ToolTrap
                            else
                                theTrapKind := OSTrap;
                            theTrapAddress := NGetTrapAddress(trap, theTrapKind);
                            SetGlobalPtr(thePatch^, theTrapAddress);
                            NSetTrapAddress(ORD(thePatch^), BAND(trapNumMask, trap), theTrapKind);
                            DetachResource(thePatch);
                            RememberPatch(thePatch, trap, theTrapAddress);
                        end
                    else
                        theState := Failed;
                end;
        end;

{The installer for VBL tasks is similar to the trap patch installer…}
        procedure InstallVBL (id, count, phase: INTEGER);
            type
                VBLTaskPtr = ^VBLTask;
            var
                theTask: Handle;
                theGlobalsHandle: Handle;
                theVBLTask: VBLTaskPtr;
                error: OSErr;

        begin
            if theState = OK then
                begin
                    theTask := GetResource(ResidentType, id);
                    if theTask <> nil then
                        begin
                            HLock(theTask);
                            SetGlobalPtr(theTask^, 0);
                            theVBLTask := VBLTaskPtr(NewPtrSys(SIZEOF(VBLTask)));
                            with theVBLTask^ do
                                begin
                                    qType := ORD(vType);
                                    vblAddr := theTask^;
                                    vblCount := count;
                                    vblPhase := phase;
                                end;
                            error := VInstall(QElemPtr(theVBLTask));
                            DetachResource(theTask);
                            RememberVBL(theTask, QElemPtr(theVBLTask));
                        end
                    else
                        theState := Failed;
                end;
        end;

{Simple inline routines to directly manipulate register A5…}
        function RegA5: LONGINT;
        inline
            $2E8D;    {MOVE.L A5,(SP)}

        procedure SetA5 (where: Ptr);
        inline
            $2A5F;    {MOVEA.L (SP)+,A5}

{Create a Quickdraw world for use by the INIT loader.}
        procedure ConstructQD;
        begin
            saveA5 := RegA5;
            SetA5(@localA5);
            LongPtr(CurrentA5)^ := LONGINT(@localA5);
            InitGraf(@localQD.thePort);
            OpenPort(@myPort);
        end;

{Destroy the INIT loader's Quickdraw world.}
        procedure DestructQD;
        begin
            ClosePort(@myPort);
            SetA5(Pointer(saveA5));
            LongPtr(CurrentA5)^ := saveA5;
        end;

{Calculate the check value for the INIT icon's horizontal position.}
        function CheckH (n: INTEGER): INTEGER;
        inline
            $301F,                {MOVE.W (SP)+,D0}
            $E358,                {ROL.W #1,D0}
            $0A40, $1021,    {EORI.W #$1021,D0}
            $3E80;                {MOVE.W D0,(SP)}

{Plot the INIT's icon in a manner compatible with the standard ShowInit routine.}
        procedure DisplayIcon (id: INTEGER);
            const
                HOffsetAddr = CurApName + 28;
                CheckAddr = CurApName + 30;
                hOffset = 40;
                vOffset = 40;
                iconResType = 'ICN#';

            type
                ICN = record
                        data: array[1..32] of LONGINT;
                        mask: array[1..32] of LONGINT;
                    end;
                ICNPtr = ^ICN;
                ICNHandle = ^ICNPtr;
                IntPtr = ^INTEGER;
                OSTypePtr = ^OSType;

            var
                theIcon: ICNHandle;
                srcRect, dstRect: Rect;
                myBitMap: BitMap;

        begin
            if EnableIcon then
                begin
                    theIcon := ICNHandle(GetResource(iconResType, id));
                    if theIcon <> nil then
                        begin
                            HLock(Handle(theIcon));
                            if CheckH(IntPtr(HOffsetAddr)^) <> IntPtr(CheckAddr)^ then
                                IntPtr(HOffsetAddr)^ := 8;
                            with myPort, dstRect do
                                begin
                                    top := portRect.bottom - vOffset;
                                    left := IntPtr(HOffsetAddr)^;
                                    bottom := top + 32;
                                    right := left + 32;
                                end;
                            with myBitMap do
                                begin
                                    baseAddr := @theIcon^^.mask;
                                    rowBytes := 4;
                                    SetRect(bounds, 0, 0, 32, 32);
                                end;
                            SetRect(srcRect, 0, 0, 32, 32);
                            CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcBic, nil);
                            myBitMap.baseAddr := @theIcon^^.data;
                            CopyBits(myBitMap, myPort.portBits, srcRect, dstRect, srcOr, nil);
                            IntPtr(HOffsetAddr)^ := IntPtr(HOffsetAddr)^ + hOffset;
                            IntPtr(CheckAddr)^ := CheckH(IntPtr(HOffsetAddr)^);
                            ReleaseResource(Handle(theIcon));
                        end;
                end;
        end;

{This is a callback routine.  It is passed as a parameter to the INIT-specific installation}
{routine, DoInstall.  The callback provides a standard way for DoInstall to access routines}
{and globals in the loader unit.}
        procedure InstallCallback (func: callbackCode; param1, param2, param3: INTEGER);
        begin
            case func of
                initCallback:
                    InitInstaller(param1, param2, param3);    {maxPatch,maxVBL,globalsSize}
                setPatch:
                    InstallPatch(param1, param2);            {resID, trapWord}
                setVBL:
                    InstallVBL(param1, param2, param3);    {resID, count, phase}
                failInstall:
                    theState := Failed;
                doNotInstall:
                    theState := Cancelled;
                suppressIcon:
                    EnableIcon := FALSE;
                otherwise
                    theState := Failed;
            end;
        end;

{Here's the main flow of the loader.  Note that the INIT's icon is not displayed until after}
{DoInstall returns, thus allowing the icon to graphically indicate the success or failure of}
{the installation.  Note also that the standard "mouse-button-down" means of skipping the}
{INIT loader is implemented here, and allows for its own distinctive icon.  Finally, note that}
{a valid Quickdraw environment is available during the entire loading process.}
    begin    {main}
        ConstructQD;    {Create a local QuickDraw environment.}
        if Button then
            DisplayIcon(loadSkipped)
        else
            begin
                StartInstall;
        {The interesting INIT code is all in DoInstall - you write it…}
                DoInstall(InstallCallback);
        {Upon return, if everthing's OK we display the "normal" icon.}
                if theState = OK then
                    DisplayIcon(loadOK)
                else
            {Something went wrong during installation - either a missing resource, or a}
            {program-detected error which was cause to skip or abort loading the INIT.}
                    begin
            {Make sure our patches and VBLs get unhooked, then indicate reason w/icon.}
                        AbortInstall;
                        if theState = Cancelled then
                            DisplayIcon(loadNotDone)
                        else
                            DisplayIcon(loadFailed);
                    end;
                EndInstall;        {Clean up installer environment.}
            end;
        DestructQD;    {Get rid of our QuickDraw environment.}
    end;

end.